{
  This program is free software; you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation; either version 2 of the License, or
  (at your option) any later version.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with this program; if not, write to the Free Software
  Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
}
{
  Generator kytarovych akordu
  Kristyna Kuncova, 1. rocnik Matematika, skupina 55
  2006/07
}

program akordy;

const
	pocet_strun	=6;
	pocet_prstu	=4;
	pocet_prazcu	=14;	
	pocet_pultonu	=12;	{tolik pultonu mame}
	jmena_pultonu	=18;	{tolik ruznych pojmenovani pultonu mame}
	max_prazcu	=3;	{rozdil mezi prazci, ktery je jeste uhratelny}
	struna_6	=5;	{cislo tonu hraneho na 0tem prazci n-te struny, tady e}
	struna_5	=0;	{struna h}
	struna_4	=8;	{struna g}
	struna_3	=3;	{d}
	struna_2	=10;	{a}
	struna_1	=5;	{nejhlubsi struna E}
	vlastnosti	=19;	{vlastnosti akordu}
	vlastnosti_r	=17;	{automaticky ctene vlastnosti}
	vlastnosti_d	=2;	{vlastnosti, jez treba udelat "rucne"}
	ak_procedur	=20;	{!!!!!!!!!!!dodelat!!!!!!!!}
	procedur	=5;	{!!!!!!!!!dopocitat!!!!!!!!!!}
	moznosti	=500;	{kolik moznosti hmatu muze mit 1 akord}


	e_neznam_vstup		='Nepripustny vstup, napiste, prosim, bud "ano" nebo "ne"';
	e_neznam_jmeno_tonu	='Zadan neznamy ton, zkontrolujte, prosim, vstupni data a ujistete se, ze pouzivate znaceni tonu obvykle v nasich krajich';
	e_moc_tonu		='Zadano prilis mnoho tonu, kytara ma bohuzel jen sest strun';
	e_malo_tonu		='Zadano prilis malo tonu, akord musi mit alespon 3';
	e_protichudne_vlastnosti ='Zadali jste protichudne vlastnosti akordu, napriklad moll a zaroven dur, takovy akord nelze vyrobit';
	e_prilis_tonu_akordu	='Vami zadany akord bohuzel obsahuje prilis mnoho tonu, takze jej nelze na kytaru zahrat';
	e_moc_basovek		='Zadano prilis mnoho basovych tonu';
	e_konflikt_3		='Zadali jste najednou sus6 (6sus), 5- nebo 5+, coz nemuze platit naraz';
	e_duplikace_7_11	='Zadali jste zaroven parametr akordu 7 a zaroven 11, undecima jiz septimu obsahuje, ujistete se prosim, zda jste nechteli kuprikladu 7maj';
	
	w_napis_tony		='Napiste tony akordu, toniku jako prvni, mezi jednotlivymi tony udelejte mezeru';
	w_zmena_bas		='Ma akord zmenenu basovou strunu? (ano/ne)';
	w_bas			='Napiste ji a odentrujte';
	w_tony_ci_akord		='Znas tony sveho akordu? (ano/ne)';
	w_chci_vlastnosti	='Napiste jmeno akordu, kazdy logicky celek oddelte mezerou';
	
type
	sest_tonu	=array [-1..pocet_strun] of integer;	{prvni policko je basovka, druhe pocet tonu akordu, zbyle ty tony}
	sest_tonu_jm	=array [1..pocet_strun] of string;	{pri cteni tonu se ukladaji sem}
	ctyricet_vl	=array [1..5,0..10] of string;		{pomoci tohoto pole tridim vlastnosti akordu, aby se pak provadely ve spravnem poradi}
	rada_vlastnosti	=array [1..40] of string;		{ukladaji se sem vlastnosti akordu pri cteni, jeste pred tridenim}
	mnozstvi_vl	=array [1..5]	of integer;		{ukladaji se sem pocty vlastnosti jednotliveho typu (aby procedury nebezely prilis dlouho)}
	policka		=array [1..pocet_strun,0..pocet_prazcu] of integer;
	vysledek	=array [1..moznosti,-1..pocet_strun] of integer;	{sem se uklada finalni verze hmatu, v kazdem radku jeden hmat, sloupce znamenaji: prvni je minimum, druhe maximum, pak po strunach cisla prazcu}
	sestice		=array [1..pocet_strun] of integer;	{sem prichazeji napr. mezivysledky hmatu}
	
var
	odpoved_tony	:string;	{pocatecni komunikace, zda budeme vytvaret akord}
	tony_akordu	:sest_tonu;	{sem budeme ukladat tony akordu}
	tony_akordu_jm	:sest_tonu_jm;	{jmena tonu akordu, budou prevedena na cisla}
	
	pole_pultonu	:array [1..jmena_pultonu] of string;	{zde jsou pultony a jejich cisla}
	cisla_pultonu	:array [1..jmena_pultonu] of integer;	{tabulka, predem dana}
	
	pole_vlastnosti	:array [1..vlastnosti] of string;	{pole s vlastnostmi, dur, moll...}
	cisla_vlastnosti:array [1..vlastnosti] of integer;	{kazda vlastnost ma prirazenu skupinu, do niz patri}
		
	abstr_vlastnosti	:rada_vlastnosti;	{sem nactu nazev akordu}
	abstr			:integer;		{a spocitam casti nazvu}
	konkr_vlastnosti	:ctyricet_vl;	{sem budeme nacitat vlastnosti}
	pocet_vlastnosti	:mnozstvi_vl;	{pocty vlstnosti jednotlivych skupin}
	
	proc		:array [1..procedur] of boolean;	{hlidani kolize vlastnosti}

	krk		:policka;	{ocislovany a oindexovany krk, aby se slo odvolavat na jeho xtou strunu a yty prazec}
	poloha		:vysledek;	{vysledne hmaty}
	

	i,j		:integer;	{pomocne, do forcyklu...}


function na_cisla(var jmeno_tonu:string):integer;	{prevod tonu na jejich ciselnou hodnotu - integer}
var	a:integer;
	ton_existuje:boolean;
	
begin
ton_existuje:=false;
for a:=1 to jmena_pultonu do
	begin
	if jmeno_tonu=pole_pultonu[a] then
		begin
		na_cisla:=cisla_pultonu[a];
		ton_existuje:=true;
		end;
	end;

if (not ton_existuje) then
	begin
	na_cisla:=-1;
	writeln(e_neznam_jmeno_tonu,' ', jmeno_tonu);
	end;

end;

procedure	na_tony (var tony:sest_tonu; var tony_jm:sest_tonu_jm);	{priradi mnou spoctenym cislum zase tony}
var	e, h:integer;
begin
for e:=1 to tony[0] do
	begin
	for h:=1 to pocet_pultonu do
		begin
		if tony[e]=cisla_pultonu[h] then
		begin
			tony_jm[e]:=pole_pultonu[h];
		end;
		end;
	end;

end;


procedure	vypis_pole(tony_jm:sest_tonu_jm);	{zjistim, jake tony akord obsahuje a touto procdurou je vypisi}
var	f:integer;
begin
for f:=1 to pocet_strun do
	write(tony_jm[f], ' ');
end;

procedure cteni_tonu (var tony:sest_tonu);	{dostanu tony akordu ze vstupu, touto procedurou je ctu, davam do pole tony_jm a pak prevadim na jejich ciselnou hodnotu, vysledek v sest_tonu}{na konec udam basovku}
var	str1, str2, str3			:string;	{krz tuto promennou ctu}
	pocitadlo, x, dl	:integer;
	tony_jm:sest_tonu_jm;

begin
writeln(w_napis_tony);

readln(str1);
read(str1);
pocitadlo:=0;

dl:=Length(str1);

while dl>0 do
begin
	pocitadlo:=pocitadlo+1;
	x:=pos(' ', str1);
	if x>0 then
		begin
		tony_jm[pocitadlo]:=copy(str1, 1, x-1 );
		str1:=copy(str1, x+1, Length(str1)-x );	
		{vezme str1 (do nej jsme cetli), a odstrihne od zacatku vse az po prvni mezeru vcetne}
		dl:=Length(str1);
		end
	else
	begin
		tony_jm[pocitadlo]:=copy(str1, 1,Length(str1) );
		str1:='';
		dl:=0;	
end;



end;
 
if pocitadlo>pocet_strun then
begin	{vice nez sestitonovy akord se nam na kytaru nevejde}
	 writeln(e_moc_tonu);
	 exit;
end;
 
if pocitadlo<(3) then
begin	{akord nemuze mit mene nez tri tony}
	 writeln(e_malo_tonu);
	 exit;
end;
for x:=1 to pocitadlo do
	tony[x]:=na_cisla(tony_jm[x]);
tony[0]:=pocitadlo;

writeln(w_zmena_bas);
readln(str2);
read(str2);
if str2='ano' then
begin
	writeln(w_bas);
	readln(str3);
	read(str3);
	tony[-1]:=na_cisla(str3);
end
else
	begin
	if str2='ne' then
		tony[-1]:=na_cisla(tony_jm[1])
	else
		writeln(e_neznam_vstup);
end
end;


procedure 	cteni_vlastnosti(var pridomek:rada_vlastnosti; var celkem:integer);		{dostanu jmeno akordu ze vstupu, timto jej ctu a 'kouskuji', abych mohla zpracovat jednotlive vlastnosti zvlast (d moll 5- 7 rozdeli na d, moll, 5-, 7, ktere pak funguji samostatne)}
var	st1	:string;	{vlastnosti akordu}
	dl, x :integer;

begin
writeln(w_chci_vlastnosti);

readln(st1);
read(st1);
celkem:=0;

dl:=Length(st1);

while dl>0 do
begin
celkem:=celkem+1;
x:=pos(' ', st1);
if x>0 then
	begin
	pridomek[celkem]:=copy(st1, 1, x-1 );
	st1:=copy(st1, x+1, Length(st1)-x );	
	{vezme str1 (do nej jsme cetli), a odstrihne od zacatku vse az po prvni mezeru vcetne}
	dl:=Length(st1);
	end
else
begin
	pridomek[celkem]:=copy(st1, 1,Length(st1) );
	st1:='';
	dl:=0;	
end;



end;
 
end;


procedure	hodnoceni_vlastnosti(var pridomek:rada_vlastnosti; var presne:ctyricet_vl; var pocitani:mnozstvi_vl; celkem:integer);	{tady se tridi vlastnosti dle priority, aby mohly byt interpretovany ve spravnem poradi a aby se neprepisovaly. zaroven jsou pocitany (ve var pocitani)}
var	m, n, o:integer;

begin

for m:=2 to 5 do
	pocitani[m]:=0;

pocitani[1]:=1;	{kvuli tonice}

presne[1,1]:=pridomek[1];

{test na dur v prvnim policku}
o:=pos(pole_vlastnosti[1],pridomek[1]);
if o<>0 then
begin
	presne[1,2]:=pole_vlastnosti[1];
	pocitani[cisla_vlastnosti[1]]:=pocitani[cisla_vlastnosti[1]]+1;
	presne[1,1]:=Copy(pridomek[1],1,Length(pridomek[1])-3);
end;
{test na dur ve zbytku}

for m:=2 to celkem do
begin
	if pridomek[m]=pole_vlastnosti[1] then
	begin
		presne[1,2]:=pole_vlastnosti[1];
		pocitani[cisla_vlastnosti[1]]:=pocitani[cisla_vlastnosti[1]]+1;	{zvetsim prislusnou charakteristiku}
	end;
	
end;

{zda se tam vyskytuje mi}
o:=pos(pole_vlastnosti[17],pridomek[1]);
if o<>0 then
begin
	presne[1,2]:='moll';
	pocitani[cisla_vlastnosti[17]]:=pocitani[cisla_vlastnosti[17]]+1;
	presne[1,1]:=Copy(pridomek[1],1,Length(pridomek[1])-2);
end;


{test na dim}
o:=pos(pole_vlastnosti[9],pridomek[1]);
if o<>0 then
begin
	presne[1,2]:='dim';
	pocitani[cisla_vlastnosti[9]]:=pocitani[cisla_vlastnosti[9]]+1;
	presne[1,1]:=Copy(pridomek[1],1,Length(pridomek[1])-3);
end;

	
{test na add}
for m:=2 to celkem do
begin
	o:=pos(pole_vlastnosti[18],pridomek[m]);
	if o<>0 then
	begin
		pocitani[cisla_vlastnosti[18]]:=pocitani[cisla_vlastnosti[18]]+1;	{zvetsim prislusnou charakteristiku}
		presne[cisla_vlastnosti[18],pocitani[cisla_vlastnosti[18]]]:=Copy(pridomek[m],o+3,Length(pridomek[m])-3);
	end;
end;


{test na /ton, jinou basovku}
o:=pos(pole_vlastnosti[19],pridomek[1]);
if o<>0 then
begin
	presne[1,1]:=Copy(pridomek[1],1,o-1);
	pocitani[cisla_vlastnosti[19]]:=pocitani[cisla_vlastnosti[19]]+1;	{zvetsim prislusnou charakteristiku}
	presne[cisla_vlastnosti[19],1]:=Copy(pridomek[1],o+1,Length(pridomek[1])-1);
	{basovka_cizi:=true;}
   writeln(presne[cisla_vlastnosti[19],1]);
   writeln(presne[4,1]);
end;

	
for m:=2 to celkem do
begin
	o:=pos(pole_vlastnosti[19],pridomek[m]);
	if o<>0 then
	begin
		presne[cisla_vlastnosti[19],1]:=Copy(pridomek[m],o+1,Length(pridomek[m])-1);
		pocitani[cisla_vlastnosti[19]]:=pocitani[cisla_vlastnosti[19]]+1;	{zvetsim prislusnou charakteristiku}
		writeln(presne[cisla_vlastnosti[19],1]);
		writeln(presne[4,1]);
	end;
end;


{pruchod vlastnostmi a jejich trideni} {od dvojky proto, ze dur (jendicka) uz byl vyzkousen vyse}
for m:=2 to celkem do
begin 
	for n:=2 to vlastnosti_r do
	begin
		if pridomek[m]=pole_vlastnosti[n] then
			begin
			pocitani[cisla_vlastnosti[n]]:=pocitani[cisla_vlastnosti[n]]+1;	{zvetsim prislusnou charakteristiku}
			presne[cisla_vlastnosti[n],pocitani[cisla_vlastnosti[n]]]:=pridomek[m];
			end;
	end;
end;

if pocitani[1]=1 then
begin
presne[1,2]:=pole_vlastnosti[1];
pocitani[1]:=2
end;

end;



procedure	dur	(var arr_tonu:sest_tonu);
begin
arr_tonu[2]:=((arr_tonu[1]+4) mod pocet_pultonu);
arr_tonu[3]:=((arr_tonu[1]+7) mod pocet_pultonu);
arr_tonu[0]:=3;
end;

procedure	moll	(var arr_tonu:sest_tonu);
begin
arr_tonu[2]:=((arr_tonu[1]+3) mod pocet_pultonu);
arr_tonu[3]:=((arr_tonu[1]+7) mod pocet_pultonu);
arr_tonu[0]:=3;
end;

procedure	dim	(var arr_tonu:sest_tonu);
begin
arr_tonu[2]:=((arr_tonu[1]+3) mod pocet_pultonu);
arr_tonu[3]:=((arr_tonu[1]+6) mod pocet_pultonu);
arr_tonu[4]:=((arr_tonu[1]+9) mod pocet_pultonu);
arr_tonu[0]:=4;
end;


procedure	septima	(var arr_tonu:sest_tonu);	{pridelam septimu, ta ma hodnotu pultonovou 11}
begin
if ((arr_tonu[0]+1)<=pocet_strun) then
begin
arr_tonu[arr_tonu[0]+1]:=((arr_tonu[1]+10) mod pocet_pultonu);	{pricitam k tonice => je treba pricist 10}
arr_tonu[0]:=arr_tonu[0]+1;
proc[2]:=false;
proc[3]:=false;
end
else
writeln(e_prilis_tonu_akordu);
end;

procedure	maj	(var arr_tonu:sest_tonu);	{pridelam septimu, ta ma hodnotu pultonovou 11}
begin
if ((arr_tonu[0]+1)<=pocet_strun) then
begin
arr_tonu[arr_tonu[0]+1]:=((arr_tonu[1]+11) mod pocet_pultonu);	{pricitam k tonice => je treba pricist 10}
arr_tonu[0]:=arr_tonu[0]+1;
proc[3]:=false;
proc[2]:=false;
end
else
writeln(e_prilis_tonu_akordu);
end;


procedure	nona	(var arr_tonu:sest_tonu);
begin
if ((arr_tonu[0]+1)<=pocet_strun) then
begin
arr_tonu[arr_tonu[0]+1]:=((arr_tonu[1]+14) mod pocet_pultonu);
arr_tonu[0]:=arr_tonu[0]+1;
end
else	writeln(e_prilis_tonu_akordu);
end;

procedure	nona_mala	(var arr_tonu:sest_tonu);
begin
if ((arr_tonu[0]+1)<=pocet_strun) then
begin
arr_tonu[arr_tonu[0]+1]:=((arr_tonu[1]+13) mod pocet_pultonu);
arr_tonu[0]:=arr_tonu[0]+1;
end
else	writeln(e_prilis_tonu_akordu);
end;

procedure	nona_vetsi	(var arr_tonu:sest_tonu);
begin
if ((arr_tonu[0]+1)<=pocet_strun) then
begin
arr_tonu[arr_tonu[0]+1]:=((arr_tonu[1]+15) mod pocet_pultonu);
arr_tonu[0]:=arr_tonu[0]+1;
end
else	writeln(e_prilis_tonu_akordu);
end;

procedure	undecima	(var arr_tonu:sest_tonu);
begin
if ((arr_tonu[0]+1)<=pocet_strun) then
begin
arr_tonu[arr_tonu[0]+1]:=((arr_tonu[1]+17) mod pocet_pultonu);
arr_tonu[0]:=arr_tonu[0]+1;
end
else	writeln(e_prilis_tonu_akordu);
end;

procedure	kvinta_min	(var arr_tonu:sest_tonu);
begin
if proc[1] then
begin
arr_tonu[3]:=((arr_tonu[1]+6) mod pocet_pultonu);
end
else
	writeln(e_konflikt_3);

proc[1]:=false;
end;

procedure	kvinta_maj	(var arr_tonu:sest_tonu);
begin
if proc[1] then
begin
	arr_tonu[3]:=((arr_tonu[1]+8) mod pocet_pultonu);
end
else
	writeln(e_konflikt_3);
proc[1]:=false;
end;

procedure	kvarta_sus(var arr_tonu:sest_tonu);
begin
arr_tonu[2]:=((arr_tonu[1]+5) mod pocet_pultonu);
end;

procedure	sexta_sus(var arr_tonu:sest_tonu);
begin
if proc[1] then
begin
	arr_tonu[3]:=((arr_tonu[1]+9) mod pocet_pultonu);
end
else
	writeln(e_konflikt_3);
proc[1]:=false;
end;

procedure	prevod_vlastnosti(var pole_tonu:sest_tonu; var charakter:ctyricet_vl; pocty:mnozstvi_vl);	{ciselna vyroba akordu}
var	s:integer;	{tuto pozici budeme predavat dal; citac pocita tony?}
begin
pole_tonu[1]:=na_cisla(charakter[1,1]);	{ukladam toniku}
pole_tonu[0]:=1;

if pocty[1]=2 then
	begin
		if charakter[1,2]=pole_vlastnosti[1] then
			dur(pole_tonu)
		else
		begin
			if (charakter[1,2]=pole_vlastnosti[2]) or (charakter[1,2]=pole_vlastnosti[17]) then
			begin
				moll(pole_tonu);
			end
			else
				dim(pole_tonu);
		end;
			
	end
else
	writeln(e_protichudne_vlastnosti);
	
for s:=1 to pocty[2] do	{pridavne kompletni pridavky, semicky, devitky, jedenact}
	begin
		if (charakter[2,s]=pole_vlastnosti[6]) and (proc[2]) then	{7}
		{kontrola, aby se mi tony negenerovaly dvakrat}
				septima(pole_tonu);
		if ( (charakter[2,s]=pole_vlastnosti[7]) or (charakter[2,s]=pole_vlastnosti[8]) )  and proc[3] then	{maj}
			maj(pole_tonu);
		if charakter[2,s]=pole_vlastnosti[10] then	{9}
			begin
				if proc[2] then
					septima(pole_tonu)
				else	writeln(e_duplikace_7_11);
			nona(pole_tonu);
			end;
		if charakter[2,s]=pole_vlastnosti[11] then	{9-}
			begin
			septima(pole_tonu);
			nona_mala(pole_tonu);
			end;
		if charakter[2,s]=pole_vlastnosti[12] then
			begin
			septima(pole_tonu);
			nona_vetsi(pole_tonu);
			end;
		if charakter[2,s]=pole_vlastnosti[3] then
			begin
			septima(pole_tonu);
			nona(pole_tonu);
			undecima(pole_tonu);
			end;
	end;

for s:=1 to pocty[3] do	{tady jsou zmeny vnitrku akordu}
	begin
	if charakter[3,s]=pole_vlastnosti[4] then
			kvinta_min(pole_tonu);
	if charakter[3,s]=pole_vlastnosti[5] then
			kvinta_maj(pole_tonu);
	if (charakter[3,s]=pole_vlastnosti[13]) or (charakter[3,s]=pole_vlastnosti[14]) then
			kvarta_sus(pole_tonu);
	if (charakter[3,s]=pole_vlastnosti[15]) or (charakter[3,s]=pole_vlastnosti[16]) then
			sexta_sus(pole_tonu);
	end;

for s:=1 to pocty[4] do		{tady jsou addy}
	begin
	if charakter[4,s]=pole_vlastnosti[3] then
			undecima(pole_tonu);
	if charakter[4,s]=pole_vlastnosti[6] then
			septima(pole_tonu);
	if (charakter[4,s]=pole_vlastnosti[7]) or (charakter[4,s]=pole_vlastnosti[8]) then
			maj(pole_tonu);
	if charakter[4,s]=pole_vlastnosti[10] then
			nona(pole_tonu);
	if charakter[4,s]=pole_vlastnosti[11] then
			nona_mala(pole_tonu);
	if charakter[4,s]=pole_vlastnosti[12] then
			nona_vetsi(pole_tonu); 
	end;

if pocty[5]>1 then
	writeln(e_moc_basovek)
else
	begin
	if pocty[5]=1 then
		pole_tonu[-1]:=na_cisla(charakter[5,1])
	else 	
		pole_tonu[-1]:=pole_tonu[1];
	end;

end;



function	barre(var policko2:sestice; var scitadlo:integer; var minim: integer):boolean;	{vstupem je hmat, vystupem informace, zda jej lze zahrat barre}{scitadlo znaci pocet prstu}
var	an, ao, citac, kde:integer;druha pulka}
	lzeto:boolean;
begin
lzeto:=false;

for an:=2 to pocet_strun do	{kolik strun bude v barre}
begin

	citac:=0;
	
	for ao:=1 to an do	{odspoda zkoumam, jestli lze udelat barre}
	begin
		if policko2[6-ao+1]=minim then	{prevracim struny}
			citac:=citac+1;
	end;
	
	if scitadlo+1-citac<=pocet_prstu then
		begin
		lzeto:=true;
		kde:=an;
		end;

	if lzeto then
	begin
		for ao:=pocet_strun downto (6-kde+1) do
			begin
			if policko2[ao]=0 then
				lzeto:=false;
			end;
	end;
	if lzeto then
		break;
end;


barre:=lzeto;
end;



function	mnoho_prstu(var policko:sestice; var min:integer):boolean;	{pocitame uzivane prsty}
var	am, pocprstu:	integer;
	jo:	boolean;
begin
pocprstu:=0;
for am:=1 to pocet_strun do
	begin
	if policko[am]>0 then
		pocprstu:=pocprstu+1;
	end;
	
if pocprstu>pocet_prstu then
begin
	jo:=barre(policko, pocprstu, min);
end
else
jo:=true;

mnoho_prstu:=jo;
end;

function	mnoho_tonu(var mezivystup3:sestice; var zadani3:sest_tonu):boolean;	{kontrola, zda byly uzity vsechny tony a tedy je akord kompletnis}
var 	k, l:integer;
	plati:array [1..pocet_strun] of boolean;
	spravne:boolean;
begin
spravne:=true;
for k:=1 to pocet_strun do
	plati[k]:=true;
for k:=1 to zadani3[0] do
	plati[k]:=false;


for k:=1 to zadani3[0] do	{kontrola, jestli jsou uzity vsechny tony}
begin
	for l:=1 to pocet_strun do 
	begin
		if krk[l, mezivystup3[l]]=zadani3[k] then
			plati[k]:=true;
	end;
end;


for k:=1 to zadani3[0] do
begin
	if not plati[k] then
		spravne:=false;
end;
		
mnoho_tonu:=spravne;
end;



procedure basovka(zadano:sest_tonu; var nejmensi3:sestice; var nejvetsi3:sestice; var mezivystup3:sestice; var pole_poloh3:vysledek; var kolik3:integer);{prida zmenenou basovku k jiz vytvorenemu akordu}

var d,e, p, r, malo, hodne:integer;
	mezivystup4:sestice;
	test_prstu:boolean;
	test_tonu:boolean;
begin

	for d:=1 to 3 do
	begin
		for p:=0 to pocet_prazcu do
		begin
			

			if (krk[d,p]=zadano[-1]) then
			begin
				for e:=-1 to 6 do
					mezivystup4[e]:=mezivystup3[e];
				mezivystup4[d]:=p;
				
				malo:=15;
				hodne:=0;
				for e:=1 to pocet_strun do
				begin
					if mezivystup4[e]>hodne then
						hodne:=mezivystup4[e];
					if (mezivystup4[e]<malo) and (mezivystup4[e]<>0) then
						malo:=mezivystup4[e];				
				end;
				
				
				if (hodne-malo<=max_prazcu) then		
				begin						
					test_prstu:=mnoho_prstu(mezivystup4, malo);
					if test_prstu=true then
					begin
					test_tonu:=mnoho_tonu(mezivystup4, zadano);
						if test_tonu=true then
						begin
							for r:=1 to pocet_strun do
							begin
								pole_poloh3[kolik3,r]:=mezivystup4[r];
							end;
							pole_poloh3[kolik3,-1]:=malo;
							pole_poloh3[kolik3,0]:=hodne;
							kolik3:=kolik3+1;
						end;
					end;
				end;
			end;
		end;
	end;
				
end;

procedure kombinace_bas(var zadani:sest_tonu; var mezivystup:sestice; var pole2_poloh:vysledek; struna:integer; var kolik:integer; var nejmensi:sestice; var nejvetsi:sestice);	{vytvari akord, kteremu se bude menit basovka}{na ktere jsme strune, kolikatou moznost hledame}
var	q, s :integer;
	
begin

for q:=1 to zadani[0] do
	begin
	s:=0;
	while (s<=pocet_prazcu) do
		begin
		if (struna=1) then
			begin
				if s<>0 then 
				begin
				nejmensi[struna]:=s;
				nejvetsi[struna]:=s;
				end
				else
				begin
					nejmensi[struna]:=15;
					nejvetsi[struna]:=1;
				end;
			end
		else
			begin
				if (s>0) and (s<nejmensi[struna-1]) then
					nejmensi[struna]:=s
				else
					nejmensi[struna]:=nejmensi[struna-1];
						
				if s>nejvetsi[struna-1] then
						nejvetsi[struna]:=s
				else
					nejvetsi[struna]:=nejvetsi[struna-1];
				
			end;
		if (nejvetsi[struna]-nejmensi[struna]<=(max_prazcu+5)) then
			begin
			if krk[struna,s]=zadani[q] then
				begin
					mezivystup[struna]:=s;
					if struna+1<=pocet_strun then
					kombinace_bas(zadani, mezivystup,pole2_poloh,struna+1,kolik, nejmensi, nejvetsi) {poustim to na dalsi strunu}
					else {zacinam testovat}
					begin
						basovka(zadani, nejmensi, nejvetsi, mezivystup, pole2_poloh,kolik);
										
					end;
				end;
			end;
				
		s:=s+1;
		end;
	end;
end;

procedure kombinace(var zadani:sest_tonu; var mezivystup:sestice; var pole2_poloh:vysledek; struna:integer; var kolik:integer; var nejmensi:sestice; var nejvetsi:sestice);	
{vytvari akord}{na ktere jsme strune, kolikatou moznost hledame}
var	q, r, s 		:integer;
	test_prstu, test_tonu	:boolean;
	
begin
for q:=1 to zadani[0] do
	begin
	s:=0;
	while (s<=pocet_prazcu) do
		begin
		if (struna=1) then
			begin
				if s<>0 then 
				begin
				nejmensi[struna]:=s;
				nejvetsi[struna]:=s;
				end
				else
				begin
					nejmensi[struna]:=15;
					nejvetsi[struna]:=1;
				end;
			end
		else
			begin
				if (s>0) and (s<nejmensi[struna-1]) then
					nejmensi[struna]:=s
				else
					nejmensi[struna]:=nejmensi[struna-1];
						
				if s>nejvetsi[struna-1] then
						nejvetsi[struna]:=s
				else
					nejvetsi[struna]:=nejvetsi[struna-1];
				
			end;
		
		if (nejvetsi[struna]-nejmensi[struna]<=max_prazcu) then
			begin
			if krk[struna,s]=zadani[q] then
				begin
					mezivystup[struna]:=s;
					if struna+1<=pocet_strun then
					kombinace(zadani, mezivystup,pole2_poloh,struna+1,kolik, nejmensi, nejvetsi) {poustim to na dalsi strunu}
					else {zacinam testovat}
					begin
					test_prstu:=mnoho_prstu(mezivystup, nejmensi[6]);
					if test_prstu=true then					
					begin					
										
						test_tonu:=mnoho_tonu(mezivystup, zadani);
						if test_tonu=true then
						begin
							for r:=1 to pocet_strun do
							begin
								pole2_poloh[kolik,r]:=mezivystup[r];
							end;
							pole2_poloh[kolik,0]:=nejvetsi[6];
							pole2_poloh[kolik,-1]:=nejmensi[6];
							kolik:=kolik+1;
						end;	
					end;
					end;
				end
			end;
				
		s:=s+1;
		end;
	end;
end;




procedure	zdvojeni(var pole_poloh4:vysledek);	{eliminace dvojnych vysledku zmenene basovky}
var	ba, bm, bb, bc	:integer;
	shoda			:boolean;

begin
bm:=0;
ba:=1;

while pole_poloh4[ba,0]<>0 do	{kolik je tam vysledku}
	begin
	bm:=bm+1;
	ba:=ba+1;	
	end;



for ba:=1 to bm-1 do	{beru vysledky jeden po druhem}
begin
	for bb:=ba+1 to bm do	{a kontroluji je s ostatnimi}
	begin
		if pole_poloh4[bb,1]<>-1 then	{aby to nebezelo zbytecne}
		begin
			shoda:=true;
			for bc:=1 to pocet_strun do	{kontroluji jednotlive struny}
			begin
				if pole_poloh4[ba,bc]<>pole_poloh4[bb,bc]
					then shoda:=false;
			end;
			if shoda=true then
			begin
				for bc:=1 to pocet_strun do
					pole_poloh4[bb,bc]:=-1;
			end;
		end;
	
	end;
end;
{kontrola}
for ba:=1 to bm do
begin
if pole_poloh4[ba,1]<>-1 then
begin
	for bc:=1 to pocet_strun do
end;


end;


end;

{zadunou to te kombinace}
procedure	hledani_polohy(var pole_tonu:sest_tonu; var pole_poloh:vysledek);	{ridi kombinace, vola jine procedury}
var	t, v	:integer;
	mezivysledek	:sestice;
	min		:array [1..pocet_strun] of integer;	
	max		:sestice;	
begin
for t:=1 to pocet_strun do
begin
	min[t]:=15;
	max[t]:=0;
end;

t:=1;
v:=1;
if pole_tonu[-1]<>pole_tonu[1] then
	begin
	kombinace_bas(pole_tonu, mezivysledek, pole_poloh, 1, v,min,max);
	
	zdvojeni(pole_poloh);
	end	
else	
	kombinace(pole_tonu, mezivysledek, pole_poloh, 1, v,min,max);


end;




{kreslitko}
 procedure	kreslitko(var poloha5:vysledek; tony5:sest_tonu);	{kreslime obrazek}
var	ka, kb, kc, kd:integer;

begin


for ka:=1 to moznosti do
	begin
	if poloha5[ka, 1]<>-1 then	{jedu dle vysledku a testuji, jestli to neni prazdne}
	begin
		for kd:=1 to pocet_strun do
		begin
		write(poloha5[ka, kd], ' ');	{vypisuji ty prazce, ciselny zapis}
		end;
		writeln;
		
		for kb:=1 to pocet_strun do	{nulty prazec tisknu zvlast}
				begin
				
				if poloha5[ka, kb]=0 then
					begin
					if (krk[kb,0]=tony5[-1]) and (kb<=3) then
					
						write('B')
					else
						write(' ');
					end
				else
					begin
						write(' ');
					end;
				
				end;
		writeln;
		
		for kb:=1 to pocet_strun do	{prvni prazec tisknu zvlast}
				begin
				
				if poloha5[ka, kb]=poloha5[ka,-1] then
					begin
					if (krk[kb,poloha5[ka,-1]]=tony5[-1]) and (kb<=3) then
						write('B')
					else
						write('o');
					end
				else
					begin
						write('|');
					end;
				
				end;
			
			writeln(' ', poloha5[ka,-1]);
		
		for kc:=poloha5[ka,-1]+1 to poloha5[ka,0] do {jdu od nejmensiho do nejvetsiho prazce}
			begin
			for kb:=1 to pocet_strun do	{jdu od nejmensi do nejvetsi struny}
				begin
				if poloha5[ka, kb]=kc then
					begin
					if (krk[kb, kc] =tony5[-1]) and (kb<=3) then
						write('B')
					else
						write('o');
					end
				else
					begin
						write('|');
					end;
				
				end;
				
			writeln;
			
			end;
			
		writeln;
		
		end;	
	end;
end;

begin
{inicializace pultonu}

pole_pultonu[1]:='c';
pole_pultonu[2]:='cis';
pole_pultonu[3]:='d';
pole_pultonu[4]:='dis';
pole_pultonu[5]:='e';
pole_pultonu[6]:='f';
pole_pultonu[7]:='fis';
pole_pultonu[8]:='g';
pole_pultonu[9]:='gis';
pole_pultonu[10]:='a';
pole_pultonu[11]:='b';
pole_pultonu[12]:='h';
pole_pultonu[13]:='des';
pole_pultonu[14]:='es';
pole_pultonu[15]:='ges';
pole_pultonu[16]:='as';
pole_pultonu[17]:='ais';
pole_pultonu[18]:='ces';

{pultonum priradim cislo}
cisla_pultonu[1]:=1;
cisla_pultonu[2]:=2;
cisla_pultonu[3]:=3;
cisla_pultonu[4]:=4;
cisla_pultonu[5]:=5;
cisla_pultonu[6]:=6;
cisla_pultonu[7]:=7;
cisla_pultonu[8]:=8;
cisla_pultonu[9]:=9;
cisla_pultonu[10]:=10;
cisla_pultonu[11]:=11;
cisla_pultonu[12]:=0;
cisla_pultonu[13]:=2;
cisla_pultonu[14]:=4;
cisla_pultonu[15]:=7;
cisla_pultonu[16]:=9;
cisla_pultonu[17]:=11;
cisla_pultonu[18]:=0;


for i:=-1 to pocet_strun do
	tony_akordu[i]:=-1;

for i:=1 to pocet_strun do
	tony_akordu_jm[i]:='';


pole_vlastnosti[1]:='dur';
pole_vlastnosti[2]:='moll';
pole_vlastnosti[3]:='11';
pole_vlastnosti[4]:='5-';
pole_vlastnosti[5]:='5+';
pole_vlastnosti[6]:='7';
pole_vlastnosti[7]:='7maj';
pole_vlastnosti[8]:='maj';
pole_vlastnosti[9]:='dim';
pole_vlastnosti[10]:='9';
pole_vlastnosti[11]:='9-';
pole_vlastnosti[12]:='9+';
pole_vlastnosti[13]:='4sus';
pole_vlastnosti[14]:='sus4';
pole_vlastnosti[15]:='6sus';
pole_vlastnosti[16]:='sus6';

pole_vlastnosti[17]:='mi';

pole_vlastnosti[18]:='add';
pole_vlastnosti[19]:='/';


cisla_vlastnosti[1]:=1;
cisla_vlastnosti[2]:=1;
cisla_vlastnosti[3]:=2;
cisla_vlastnosti[4]:=3;
cisla_vlastnosti[5]:=3;
cisla_vlastnosti[6]:=2;
cisla_vlastnosti[7]:=2;
cisla_vlastnosti[8]:=2;
cisla_vlastnosti[9]:=1;
cisla_vlastnosti[10]:=2;
cisla_vlastnosti[11]:=2;
cisla_vlastnosti[12]:=2;
cisla_vlastnosti[13]:=3;
cisla_vlastnosti[14]:=3;
cisla_vlastnosti[15]:=3;
cisla_vlastnosti[16]:=3;

cisla_vlastnosti[17]:=1;
cisla_vlastnosti[18]:=4;
cisla_vlastnosti[19]:=5;


{sem prijdou uz roztridene vlastnosti akordu}
for i:=1 to 4 do
begin
	for j:=1 to 10 do
	konkr_vlastnosti[i,j]:='';
end;



{sem prijde pocet vlastnosti - i kvuli kontrole}
for i:=1 to 4 do
	pocet_vlastnosti[i]:=0;
	
for i:=1 to procedur do		{zda procedura muze probehnout}
	proc[i]:=true;

krk[1,0]:=struna_1;
krk[2,0]:=struna_2;
krk[3,0]:=struna_3;
krk[4,0]:=struna_4;
krk[5,0]:=struna_5;
krk[6,0]:=struna_6;

for i:=1 to pocet_strun do
begin
	for j:=1 to pocet_prazcu do
	krk[i,j]:=(krk[i,0]+j)mod pocet_pultonu;
end;

for i:=1 to moznosti do
begin
	for j:=1 to pocet_strun do
	poloha[i,j]:=-1;
end;



{zacatek komunikace}
writeln(w_tony_ci_akord);
read(odpoved_tony);

if (odpoved_tony='ano') then
	begin
	cteni_tonu(tony_akordu);
	
	hledani_polohy(tony_akordu, poloha);
	kreslitko(poloha,tony_akordu);
	end
	else
	begin
		if (odpoved_tony='ne') then
			begin
			cteni_vlastnosti(abstr_vlastnosti, abstr);
			hodnoceni_vlastnosti(abstr_vlastnosti, konkr_vlastnosti, pocet_vlastnosti, abstr);
			prevod_vlastnosti(tony_akordu, konkr_vlastnosti, pocet_vlastnosti);
			na_tony(tony_akordu, tony_akordu_jm);
			vypis_pole(tony_akordu_jm);
			
			hledani_polohy(tony_akordu, poloha);
			kreslitko(poloha,tony_akordu);
			
			end
		else
			writeln(e_neznam_vstup);
	end;

end.